\ Flash Player Example for VFX Forth
\ Tom Dixon
\ 9/9/2008

include FCOMbase.bld
include ACTIVEX
also FCOM

\ Type library for Shockwave Flash Player
1 0 typelib {D27CDB6B-AE6D-11CF-96B8-444553540000}

IShockwaveFlash comiface Flash

cr ." Flash Interfaces" interfaces cr
cr ." Methods in IShockwaveFlash" cr  IShockwaveFlash words

: flash-close ( -- ) Flash freeref ;

: Movie! ( str len -- f ) >unicode drop Flash PutMovie ;
: Movie@ ( -- str len )
   pad Flash GetMovie drop
   pad @ dup >r zunicount >ascii r> fSysFreeString  ;
: Play ( -- ) Flash Play drop ;
: StopMovie ( -- ) Flash Stop drop ;
: Back ( -- ) Flash Back drop ;
: Forward ( -- ) Flash Forward drop ;
: Rewind ( -- ) Flash Rewind drop ;
: StopPlay ( -- ) Flash StopPlay drop ;
: GotoFrame ( n -- ) Flash GotoFrame drop ;
: CurrentFrame ( -- n ) pad Flash CurrentFrame drop pad @ ;
: TotalFrames ( -- n ) pad Flash GetTotalFrames drop pad @ ;
: Playing? ( -- flag ) pad Flash IsPlaying drop pad @ ;
: Loaded% ( -- percent ) pad Flash PercentLoaded drop pad @ ;
: LoopMovie ( flag -- ) Flash PutLoop drop ;
: LoopMovie? ( -- flag ) pad Flash GetLoop drop pad @ ;
: Pan ( n n n -- ) Flash Pan drop ;
: Zoom ( n -- ) Flash Zoom drop ;
: SetZoomRect ( n n n n -- ) Flash SetZoomRect drop ;
: BGColor ( -- color ) pad Flash GetBackgroundColor drop pad @ ;
: SetBGColor ( color -- ) Flash PutBackgroundColor drop ;


\ =====================================================
\ Define a Window resource Template for the Main Window
\ =====================================================

NULL value hChild
NULL value hWindow

NextID: IDW_MAINWINDOW

IDW_MAINWINDOW WINDOW 0, 0, 300, 300
BEGIN
   Caption         "ActiveX Window"
   Style           WS_POPUP | WS_BORDER | WS_SYSMENU |
                   WS_CAPTION | WS_THICKFRAME | WS_MINIMIZEBOX |
                   WS_MAXIMIZEBOX | WS_CLIPSIBLINGS | WS_VISIBLE
   ClassStyle      CS_HREDRAW | CS_VREDRAW
   Icon            IDI_APPLICATION
   Cursor          IDC_ARROW
   Brush           WHITE_BRUSH
   Menu            NULL
   WndProc         TestWindowProc
END

: Resize-Child ( lparam -- )
  hChild 0 rot 0 swap
  dup $FFFF and swap 16 rshift $FFFF and
  1 MoveWindow drop ;


\ =====================================================
\ Child window that will host the ActiveX control
\ =====================================================

NextID: IDW_Child

IDW_Child WINDOW    0, 0, 300, 280
BEGIN
        Caption     "ActiveX child window"
        Style       WS_VISIBLE | WS_THICKFRAME | CCS_NORESIZE
        ClassStyle  CS_HREDRAW | CS_VREDRAW
        Icon        IDI_APPLICATION
        Cursor      IDC_ARROW
        Brush       WHITE_BRUSH
        Menu        NULL
        WndProc     ChildWindowProc
END

: ChildWindowProc       { hwnd mesg wparam lparam -- ior }
  case mesg
    WM_CREATE of  hwnd -> hChild  1  endof      \ 1 so that default is performed
    WM_DESTROY of  0 -> hChild  1  endof        \ 1 so that default is performed
      drop  hwnd mesg wparam lparam DefWindowProc
  end-case
;

: RunChild      \ --
  hChild 0= if
    IDW_Child hWindow RESOURCE::CreateChildWindow -> hChild
    ShockwaveFlash CLSID>Str >ascii hChild AXCreate
    Flash freeref
    Flash IShockwaveFlash hChild AXQuery
  endif
;

: CloseChild    \ --
  hChild if
    flash-close  hChild SendClose
  endif
;

: TestWindowProc        \ hWnd uMessage wParam lParam -- res
  { hWnd uMessage wParam lParam -- res }
  uMessage case
    WM_SIZE of  lParam Resize-Child  0  endof
    WM_CREATE of  hWnd -> hWindow  1  endof
    WM_DESTROY of  0 -> hWindow  1  endof
      drop  hWnd uMessage wParam lParam DefWindowProc
  end-case
;

: Run ( -- )
  hWindow 0= if
    IDW_MAINWINDOW Resource::CreateParentWindow -> hWindow
    RunChild
  endif
;

: Close ( -- )
  hWindow if
    CloseChild  hWindow SendClose
  endif ;

free-lasttypelib
previous

Run
\ s" C:\Products\VfSfp\ActiveX\TomDixon\Vfx\clock.swf" movie! drop play
s" C:\Program Files\VFXPro\clock.swf" movie! drop play

